#!/usr/bin/perl

######################################################################
package Swignition::uF::hEvent;
######################################################################

use CGI::Util;
use Swignition::GenericParser::Utils;
use Swignition::uF;
use Swignition::uF::species;
use XML::LibXML qw(:all);
use strict;

sub cc
{
	$_ = shift;
	s/\-([a-z])/uc($1)/eg;
	return $_;
}

sub parse_all
{
	my $page   = shift;
	my $within = shift || $page->{DOM};
	my @nodes = searchClass('vevent', $within);
	my @rv;
	
	foreach my $ev (@nodes)
	{
		push @rv, parse($page, $ev);
	}
	
	return @rv;
} #/sub parse_all


sub uri
{
	my $this = shift;
	my $all  = shift;
	my @rv;
	
	if (length $this->{_id})
	{
		push @rv, Swignition::uF::TDBURI($this->{_page}->uri.'#'.$this->{_id});
	}
	if (lc($this->{_dom}->tagName) eq 'body')
	{
		push @rv, Swignition::uF::TDBURI($this->{_page}->uri);
	}
	if (length $this->{uid})
	{
		push @rv, Swignition::uF::UIDURI($this, 'cal');
	}
	push @rv, Swignition::GenericParser::Utils::BNodeURI($this->{_dom}, 'Event')
		unless (@rv);
	
	return $rv[0] unless (defined $all);
	while ($all) { shift @rv; $all--; }
	return @rv;
} #/sub uri


sub rdf_subject
{
	my $this    = shift;
	my $ns      = 'http://www.w3.org/2002/12/cal/ical#';
	my $CLASS   = shift;

	# Create RDF subject
	my $subject = Swignition::RDFModel::Subject->new($this->uri);
	$subject->addObject($this);
	$subject->setDom($this->{_dom});
	
	if ($CLASS =~ /htodo$/i)
	{
		$subject->addVal('http://www.w3.org/1999/02/22-rdf-syntax-ns#type',
			Swignition::RDFModel::Value->new($ns.'Vtodo', 1));
	}
	else
	{
		$subject->addVal('http://www.w3.org/1999/02/22-rdf-syntax-ns#type',
			Swignition::RDFModel::Value->new($ns.'Vevent', 1));
	}
	
	# Patterns for simple data.
	my @_SINGLES  = qw(dtstart summary class created description dtend dtstamp
		duration last-modified priority sequence status transp 
		due percent-complete completed recurrance-id uid);
	my @_SINGLESR = qw(url parent);
	my @_MULTIS   = qw(comment exdate exrule rdate resources rrule);
	my @_MULTISR  = qw(child sibling);
	my @_OBJECTS  = qw(attach attendee categories contact geo location organizer
		valarm x-sighting-of);
	
	# Properties which exist as singles.
	foreach my $property (@_SINGLES)
	{
		next unless (length $this->{$property});
		my $val = Swignition::RDFModel::Value->new($this->{$property});
		if ($property =~ /^(percent.complete|sequence)/)
			{ $val->setDatatype('http://www.w3.org/2000/01/rdf-schema#Integer'); }
		$subject->addVal($ns.cc($property), $val);
	}

	# Resource-type properties which exist as singles.
	foreach my $property (@_SINGLESR)
	{
		next unless (length $this->{$property});
		my $val = Swignition::RDFModel::Value->new($this->{$property}, 1);
		if ($property eq 'parent')
			{ $subject->addVal('http://buzzword.org.uk/rdf/icalx#'.$property, $val); }
		else
			{ $subject->addVal($ns.cc($property), $val); }
	}
		
	# Properties which exist as multiple values.
	foreach my $property (@_MULTIS)
	{
		foreach my $V (@{ $this->{$property} })
		{
			next unless (length $V);
			my $val = Swignition::RDFModel::Value->new($V);
			$subject->addVal($ns.cc($property), $val);
		}
	}
	
	# Resource-type properties which exist as multiple values.
	foreach my $property (@_MULTISR)
	{
		foreach my $V (@{ $this->{$property} })
		{
			next unless (length $V);
			my $val = Swignition::RDFModel::Value->new($V, 1);
			if ($property eq 'child' || $property eq 'sibling')
				{ $subject->addVal('http://buzzword.org.uk/rdf/icalx#'.$property, $val); }
			else
				{ $subject->addVal($ns.cc($property), $val); }
		}
	}

	# Embedded objects which may be represented as resources
	foreach my $property (@_OBJECTS)
	{
		foreach my $V (@{ $this->{$property} })
		{
			my $val;
			if (ref $V && $V->can('uri'))
				{ $val = Swignition::RDFModel::Value->new($V->uri, 1); }
			else
				{ $val = Swignition::RDFModel::Value->new($V); }
				
			if ($property eq 'x-sighting-of')
				{ $subject->addVal('http://purl.org/NET/biol/auxiliary#sightingOf', $val); }
			elsif ($property eq 'valarm')
				{ $subject->addVal('http://buzzword.org.uk/rdf/icalx#valarm', $val); }
			else
				{ $subject->addVal($ns.cc($property), $val); }
		}
	}
	
	return $subject;
	
} #/sub rdf_subject


sub metadata_ns
{
	return {
		'i'  => { nsurl=>'http://www.w3.org/2002/12/cal/ical#',    title=>'RDF Calendar' },
		'ix' => { nsurl=>'http://buzzword.org.uk/rdf/icalx#', title=>'RDF Calendar (Extentions)' }
		};
} #/sub metadata_ns


sub parse
{
	my $page = shift;
	my $rv = { '_dom'=>shift };
	my $CLASS = shift;
	$CLASS = (length $CLASS) ? $CLASS : 'Swignition::uF::hEvent';
	my $pkg = $CLASS;
	if (defined $page->{uF}->{_Shortcuts}->{$pkg}->{ $rv->{_dom}->getAttribute('_xpath') })
		{ return $page->{uF}->{_Shortcuts}->{$pkg}->{ $rv->{_dom}->getAttribute('_xpath') }; }
	else
		{ $page->{uF}->{_Shortcuts}->{$pkg}->{ $rv->{_dom}->getAttribute('_xpath') } = $rv; }
	
	my $event_node = $rv->{'_dom'}->cloneNode(1);
	
	my $id = $event_node->getAttribute('id');
	$rv->{_id} = $id if (length $id);
	$rv->{_page} = $page;
	
	&Swignition::uF::data_patterns($page, $event_node, 6);
	
	# Embedded species - too tricky for simple_parse().
	my @nested = searchClass('biota', $event_node);
	foreach my $h (@nested)
	{
		if ($h->getAttribute('class') =~ / (^|\s) (attendee) (\s|$) /x)
		{
			push @{ $rv->{'x-sighting-of'} }, Swignition::uF::species::parse($page, $h);
		}
		my $newClass = $h->getAttribute('class');
		$newClass =~ s/\b(attendee|x.sighting.of)\b//g;
		$h->setAttribute('class', $newClass);
	}

	&Swignition::uF::simple_parse(
		$rv,
		$event_node,
		[
			['attach',           'u*'],
			['attendee',         'M*',  {embedded=>'hCard !person', 'is-in-cal'=>1}],
			['categories',       '*'],
			['category',         '*',   {'use-key'=>'categories'}],
			['class',            '?'],
			['comment',          '*'],
			['completed',        'd?'],
			['contact',          'M*',  {embedded=>'hCard !person', 'is-in-cal'=>1}],
			['created',          'd?'],
			['description',      '?'],
			['dtend',            'd?'],
			['dtstamp',          'd?'],
			['dtstart',          'd1'],
			['due',              'd?'],
			['duration',         'D?'],
			['exdate',           'd*'],
			['geo',              'M*',  {embedded=>'geo'}],
			['last-modified',    'd?'],
			['location',         'M*',  {embedded=>'hCard adr geo'}],
			['organizer',        'M*',  {embedded=>'hCard !person', 'is-in-cal'=>1}],
			['percent-complete', '?'],
			['priority',         '?'],
			['rdate',            'd*'],
			['recurrance-id',    'U?'],
			['resource',         '*',   {'use-key'=>'resources'}],
			['resources',        '*'],
			['sequence',         '?'],
			['status',           '?'],
			['summary',          '1'],
			['transp',           '?'],
			['uid',              'U?'],
			['url',              'U?'],
			['valarm',           'M*',  {embedded=>'hAlarm'}],
			['x-sighting-of',    'M*',  {embedded=>'species'}]
		],
		{
			'rel-tag'       => 'categories',
			'rel-enclosure' => 'attach',
			'hmeasure'      => 'measures'
		}
	);
	
	# Recurrance rules - too tricky for simple_parse()
	my @simples = qw(exrule rrule);
	foreach my $simple (@simples)
	{
		my @value_nodes = searchClass($simple, $event_node);
		foreach my $value_node (@value_nodes)
		{
			next unless ($value_node);			
			my $value = recurrance($value_node);
			push @{$rv->{$simple}}, $value;
		}
	}	

	# Related-to - too tricky for simple_parse()
	my @relations = searchClass('related-to', $event_node);
	foreach my $r (@relations)
	{
		if ($r->tagName !~ /^(a|area|link)$/i)
			{ push @{$rv->{sibling}}, STRINGIFY($r, 'value'); }
		elsif ($r->getAttribute('rel') =~ /vcalendar-parent/i && !defined $rv->{parent})
			{ $rv->{parent} = $page->uri($r->getAttribute('href')); }
		elsif ($r->getAttribute('rel') =~ /vcalendar-child/i)
			{ push @{$rv->{child}}, $page->uri($r->getAttribute('href')); }
		else
			{ push @{$rv->{sibling}}, $page->uri($r->getAttribute('href')); }
	}

	# If no parent, then try to find a link with rel="vcalendar-parent" but no
	# class="related-to".
	unless ($rv->{parent})
	{
		@relations = searchRel('vcalendar-parent', $event_node);
		my $r = shift @relations;
		$rv->{parent} = $page->uri($r->getAttribute('href')) if ($r);
	}
	
	# Find additional siblings.
	@relations = searchRel('vcalendar-sibling', $event_node);
	foreach my $r (@relations)
	{
		push @{$rv->{sibling}}, $page->uri($r->getAttribute('href'))
			unless ($r->getAttribute('class') =~ /related-to/);
	}
	
	# Find additional children.
	@relations = searchRel('vcalendar-child', $event_node);
	foreach my $r (@relations)
	{
		push @{$rv->{child}}, $page->uri($r->getAttribute('href'))
			unless ($r->getAttribute('class') =~ /related-to/);
	}
	
	bless $rv, $CLASS;
	Swignition::uF::error_list_process($rv, $page, 'http://microformats.org/wiki/User:TobyInk/hcalendar-1.1');
	return $rv;
	
} #/sub parse


sub recurrance
{
	my $node = shift;
	my %props = {};
	
	my @freq_nodes = searchClass('freq', $node);
	unless (defined $freq_nodes[0])
	{
		if (lc($node->tagName) eq 'abbr' && length $node->getAttribute('title'))
			{ return $node->getAttribute('title'); }
		else
			{ return STRINGIFY($node, 'value'); }
	}

	$props{freq} = uc STRINGIFY($freq_nodes[0], 'value');
	
	foreach my $n ($node->getElementsByTagName('*'))
	{
		if ($n->getAttribute('class') =~ /\b (until|count) \b/x)
		{
			my $p = $1;
			unless (defined $props{'until'} || defined $props{'count'})
			{
				$props{$p} = STRINGIFY($n, 'value');
				$props{$p} = Swignition::uF::datetime($props{$p}) if ($p eq 'until');
			}
		}
		
		elsif ($n->getAttribute('class') =~ /\b (bysecond | byminute | byhour |
			bymonthday | byyearday | byweekno | bymonth | bysetpos) \b/x)
		{
			my $p = $1;
			my $v = STRINGIFY($n, 'value');
			if (length $props{$p})
			{
				$props{$p} .= ",$v";
			}
			else
			{
				$props{$p} = "$v";
			}
		}

		elsif ($n->getAttribute('class') =~ /\b (byday | wkst) \b/x)
		{
			my $p = $1;
			my $txt = STRINGIFY($n, 'value');
			my $v;

			if ($txt =~ /^\s*(\-?[12345])?\s*(MO|TU|WE|TH|FR|SA|SU)/i)
				{ $v = uc($1.$2); }
			else
				{ $v = uc($txt); }
				
			if (length $props{$p})
				{ $props{$p} .= ",$v"; }
			else
				{ $props{$p} = "$v"; }
		}
		
		if ($n->getAttribute('class') =~ /\b interval \b/x)
		{
			my $v = STRINGIFY($n, 'value');
			$props{'interval'} = $v;			
		}
	}
	
	my $rv = '';
	foreach my $k (keys %props)
	{
		$rv .= uc($k).'='.$props{$k}.';'
			unless ($k =~ /^HASH/); # huh?
	}
	$rv =~ s/\;$//;
	
	return $rv;
}

1; #/package Swignition::uF::hEvent




